home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tool-inc.zip / POP3.INC < prev    next >
Text File  |  1989-03-01  |  3KB  |  113 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * popup - utility library for simple "pop-up" windows (3-1-89)
  15.  *
  16.  *)
  17.  
  18. type
  19.    videoram =          array [0..1999] of word;
  20.    videoptr =          ^videoram;
  21.  
  22.    window_save_rec = record
  23.       WindMin:    word;
  24.       WindMax:    word;
  25.       TextAttr:   integer;
  26.       CuX:        integer;
  27.       CuY:        integer;
  28.       Image:      videoram;
  29.    end;
  30.  
  31. var
  32.   { saved_window: window_save_rec; }
  33.    disp_mem:     videoptr;
  34.    
  35.  
  36. procedure setcolor(fg,bg: integer);
  37. begin
  38.    bg := bg and 7;
  39.    crt.textcolor(fg);
  40.    crt.textbackground(bg);
  41. end;
  42.  
  43. function make_string(c: char; len: integer): string;
  44.    {make a string by repeating a character n times}
  45. var
  46.    i:  integer;
  47.    s:  string;
  48. begin
  49.    for i := 1 to len do
  50.       s[i] := c;
  51.    s[0] := chr(len);
  52.    make_string := s;
  53. end;
  54.  
  55.  
  56. procedure disp (s:                  string);
  57. begin
  58.    write(s);
  59. end;
  60.  
  61. procedure displn(s: string);       {fast display and linefeed}
  62. begin
  63.    writeln(s);
  64. end;
  65.  
  66.  
  67. procedure window(x1,y1,x2,y2: integer);
  68. var
  69.    wx,wy: integer;
  70. begin
  71.    wx := wherex + lo(crt.WindMin);    {get absolute cursor location}
  72.    wy := wherey + hi(crt.WindMin);  
  73.    crt.window(x1,y1,x2,y2);
  74.    if (x1=1) and (y1=1) then
  75.       crt.gotoxy(wx,wy);
  76. end;
  77.  
  78. procedure save_window(var saved: window_save_rec);
  79.    (* save the current window so it can be restored later *)
  80. begin
  81.    saved.Image := disp_mem^;
  82.    saved.WindMin := crt.WindMin;
  83.    saved.WindMax := crt.WindMax;
  84.    saved.CuX := crt.WhereX;
  85.    saved.CuY := crt.WhereY; 
  86.    saved.TextAttr := crt.TextAttr;
  87. end;
  88.  
  89. procedure restore_window(saved: window_save_rec);
  90.    (* restore the windowing settings *)
  91. begin                   
  92.    disp_mem^ := saved.Image;
  93.    window(lo(saved.WindMin)+1, hi(saved.WindMin)+1,
  94.           lo(saved.WindMax)+1, hi(saved.WindMax)+1);
  95.    crt.GotoXY(saved.CuX,saved.CuY);
  96.    crt.TextColor(lo(saved.TextAttr));
  97.    crt.TextBackground(hi(saved.TextAttr));
  98. end;
  99.  
  100.  
  101. procedure init_pop_up;
  102.    {call once before anything else in this library}
  103. begin
  104.    if crt.LastMode = crt.Mono then
  105.       disp_mem := ptr($B000,0)
  106.    else       
  107.       disp_mem := ptr($B800,0);
  108.  
  109.    window(1,1,80,25);
  110. end;
  111.  
  112.  
  113.